home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
AMRA2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
63KB
|
1,928 lines
UNIT AMRA2;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ File areamanager # RaFileman Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, Dos, OpWindow, OpPick,
AMList, OproUtil;
TYPE
FILESHDRRECORD = RECORD
NAME : STRING [12];
SIZE,
CRC32 : LONGINT;
UPLOADER : STRING [35];
UPLOADDATE,
FILEDATE,
LASTDL : LONGINT;
TIMESDL : WORD;
ATTRIB : BYTE;
PASSWORD : STRING [15];
KEYWORD : ARRAY [1..5] OF
STRING [15];
COST : WORD;
LONGDESCPTR : LONGINT;
FREESPACE : ARRAY [1..20] OF
BYTE;
END;
{ ATTRIB - BIT 0 : DELETED
1 : UNLISTED
2 : FREE (DON'T ADJUST RATIO) - DOES NOT AFFECT "COST"
3 : NOT AVAILABLE (DON'T ALLOW DOWNLOADS)
4 : LOCKED (NO KILL)
5 : MISSING/OFFLINE
6 : NO TIME RESTRICTIONS - ALWAYS ALLOW DL }
{ Freespace - BIT 1 : File Exist
20 : Selected
( These Bit are zeroed then file is written to disk again }
FILESIDXRECORD = RECORD
NAME : STRING [12];
UPLOADDATE : LONGINT;
KEYWORDCRC : ARRAY [1..5] OF
LONGINT;
LONGDESCPTR : LONGINT;
END;
CONST
{ FALGS }
RaDELETED = $0001;
RaUNLISTED = $0002;
RaFREE = $0004;
RaNOTAVAILABLE = $0008;
RaLOCKED = $0010;
RaMISSING = $0020;
RaTIME = $0040;
TYPE
FileStr = STRING [12]; {Room for just a filename}
RARec = RECORD
SIZE : LONGINT; {Size of file}
NAME : FileStr; {Name and extension of file}
ATTRIB : BYTE; {File attribute}
LONGDESCPTR : LONGINT;
FILEDATE,
UPLOADDATE,
LASTDL : LONGINT;
COST,
TIMESDL : WORD;
END;
RARecArray = ARRAY [1..2000] OF ^FILESHDRRECORD;
RaList = object(Alist)
RarPtr : RARecArray;
HDRREC : FILESHDRRECORD;
Rafiles,
Ralines : WORD;
RaSelected : WORD;
MAXLINES,
Rasize : LONGINT;
RaSelSize : LONGINT;
RaAreanumber : WORD;
RamoveAreanumber : WORD;
RaMoveAreaPath : Pathstr;
RaMask : fileStr;
RaAreaname : STRING;
RaTEXTFILE : TbufTextfile;
RaDescWin : WindowPtr;
RaDesc : ARRAY [1..500] OF CHAR;
Desclines : ARRAY [1..4] OF STRING [80];
constructor Init;
DESTRUCTOR Done; virtual;
FUNCTION RaLoadfiles : BOOLEAN;
PROCEDURE RaWritefiles;
PROCEDURE RaDelocatefiles;
PROCEDURE Writedescription_To_window (LONGDESCPTR : LONGINT);
PROCEDURE ReadDescLine (VAR DESC : STRING; NUM : LONGINT);
PROCEDURE ReadLnFromMem (VAR DESC : STRING; NUM : LONGINT);
PROCEDURE Writeln2Mem (DESC : STRING; NUM : LONGINT);
PROCEDURE Editdescline;
PROCEDURE EditDescField;
PROCEDURE EDITATTRIBUTES;
PROCEDURE Insertline (NUM : WORD; Ask : BOOLEAN);
PROCEDURE DeleteOneLine (Ask, Del : BOOLEAN; NUM : WORD);
PROCEDURE Deleteline (Ask : BOOLEAN);
PROCEDURE TouchFile;
PROCEDURE Moveline;
PROCEDURE MoveFileInSameArea;
PROCEDURE RenameLine;
PROCEDURE TouchAllFiles;
FUNCTION AdoptOrphans (Silent, EnterUploader : BOOLEAN) : BOOLEAN;
PROCEDURE ResetDownloadCounters;
PROCEDURE GlobalCommands;
PROCEDURE RaQuickSort (First, Last : WORD);
PROCEDURE RaSortFiles;
PROCEDURE TotalHeader;
PROCEDURE SelectedHeader;
PROCEDURE RaClearSelected;
PROCEDURE SendFilesToNode;
PROCEDURE HatchFiles;
PROCEDURE Centerline;
PROCEDURE Joinlines;
PROCEDURE ViewGIF;
PROCEDURE ImportDescription;
Procedure Reverse_Select;
Procedure MenuSelect(MarkLine : Boolean);
PROCEDURE ItemString (Item : WORD; Mode : pkMode;
VAR IType : pkItemType;VAR IString : STRING); virtual;
PROCEDURE Premove; virtual;
PROCEDURE AreaManagerMain;
END;
IMPLEMENTATION
USES OpCrt, OpDos, OpInline, OpKey, OpDate, OpString, OpRoot, OpCmd, OpFrame,
OpField, OpEdit, OpMemo, OpEntry,
Tick , AreaMan, AMFBBS, OutUtil, ArcView, NodeList, Input, Display, NetFile,
AreaMisc, MailUtil, FileUtil, StrUtil, Util, Resource,
Keyboard, PoPTypes, Globals;
PROCEDURE RaAreaManagerKbdStatProc (KbdFlags : BYTE);
far;
VAR
s, ss : S80;
BEGIN
s := '';
ss := '';
CASE KbdFlags OF
0 : BEGIN
s := 'F1=Help F2=Delete line F3=Edit descr. F4=Move/Copy F5=Rename File';
ss := 'F6=Touch File F7=Insert line F8=Sort files F9=View Archive F0=Global cmds';
END;
2, 1 : BEGIN
s := 'F1=Send files F2=Hatch tick F3=Center line F4=Join lines';
ss := ' F9=View Picture F0=Edit Attrib';
END;
8 : Begin
s := ' F3=Import DIZ';
ss := ' ';
END;
END;
WITH Cfg.Color [2] DO
BEGIN
FastText (CPad (s, 80), ScreenHeight - 1, 1);
FastText (CPad (ss, 80), ScreenHeight, 1);
END;
END;
PROCEDURE RaFindFile(A : Alistptr);
VAR
Z, i, j, k : INTEGER;
s : STRING;
DS, Dss : STRING;
Conf,
Found : BOOLEAN;
Temp2 : windowPtr;
THDRFILE : TNetFile;
THDRREC : FILESHDRRECORD;
Textfile : TNetFile;
BEGIN
IF InputString (5, 8, 70, 50, 3, 'Search', 'File : ', s) THEN
BEGIN
s := StUpCase (s);
FOR i := 1 TO Numarea DO
BEGIN
IF GotEsc THEN
Break;
A^.CurrentArea := i;
THDRFILE.Open(FDBPATH + 'HDR\fdb' + Long2str (i) + '.HDR', SIZEOF (THDRREC), FALSE);
k := THDRFILE.FILESIZE;
FOR j := 1 TO k DO
BEGIN
Found := FALSE;
THDRFILE.Read(THDRREC, NoKeep, Wait);
IF POS (s, StUpCase (THDRREC.NAME) ) <> 0 THEN
BEGIN
Dss := '';
Textfile.Open(FDBPATH + 'TXT\fdb' + Long2str (i) + '.TXT', 1, FALSE);
Textfile.SEEK(THDRREC.LONGDESCPTR );
IF Textfile.IORESULT = 0 THEN
BEGIN
FILLCHAR (DS, SIZEOF (DS), #0);
Textfile.BLOCKREAD (DS[1] , 80);
Z := 1;
WHILE NOT (DS [Z] = #0) DO
BEGIN
Dss := Dss + DS [Z];
INC (Z);
END;
END;
Textfile.Close;
MyWin (Temp2, 3, 8, 78, 12, 4, 'Found...', FALSE);
Temp2^.wFastWrite ('Area: (' + Area^ [i]^.tag^ + ') ' + Area^ [i]^.title^,
1, 2, Cfg.Color [4] .HighlightColor);
Temp2^.wFastWrite ('File: ' + THDRREC.NAME, 2, 2, Cfg.Color [4] .HighlightColor);
Temp2^.wFastWrite ('Desc: ' + Dss, 3, 2, Cfg.Color [4] .HighlightColor);
Conf := Confirm ('Continue search ?', 'N', 14);
KillWindow (Temp2);
IF NOT Conf THEN
BEGIN
Found := TRUE;
THDRFILE.Close;
Break;
END;
END;
END;
IF Found THEN
BEGIN
StuffKey (Enter);
A^.TopArea := i - 1;
A^.AreaLine := 1;
A^.StartLine := j - 1;
THDRFILE.Close;
Break;
END;
END;
THDRFILE.Close;
END;
END;
{$F+}
FUNCTION RaMultipleChoiceCommand (VAR Cmd : WORD;
P : PickListPtr) : BOOLEAN;
VAR
HelpTopic : WORD;
SavePkFlags : WORD;
BEGIN
RaMultipleChoiceCommand := FALSE;
WITH P^ DO
BEGIN
CASE GETLASTKEY OF
F3, F2, Del, F4, F5, F6, F7, INS, F8, F9, F10,
ShF1, ShF2, ShF3, ShF4, ShF9, ShF10,
AltF3,
Star, Plus, Minus,PadStar, PadPlus, PadMinus : RaMultipleChoiceCommand := TRUE;
ELSE
CASE Cmd OF
ccNone : pkResetSearchStr; {Invalid keystroke}
ccChar : {Alphanumeric, possibly used for searching}
IF FlagIsSet (pkSecFlags, pkEvaluating) OR OKToChangeChoice THEN
RaMultipleChoiceCommand := ItemSearch;
ccUp, ccDown, {Cursor movements}
ccPageUp, ccPageDn,
ccHome, ccEnd,
ccLeft, ccRight,
ccNextXref, ccPrevXref,
ccTopOfFile, ccEndOfFile :
IF FlagIsSet (pkSecFlags, pkEvaluating) OR OKToChangeChoice THEN
BEGIN
pkResetSearchStr;
RaMultipleChoiceCommand := pkProcessCursorCommand (Cmd);
END;
{$IFDEF UseMouse}
ccMouseSel, {Select with mouse, mouse left button up}
ccMouseDown, {Mouse left button down}
ccMouseAuto : {Mouse moved with left down or autorepeat}
IF FlagIsSet (pkSecFlags, pkEvaluating) OR OKToChangeChoice THEN
BEGIN
pkResetSearchStr;
RaMultipleChoiceCommand := pkProcessMouseCommand (Cmd, TRUE);
END;
{$ENDIF}
ccHelp : {Help}
BEGIN
IF FlagIsSet (pkFlags, pkUseItemForTopic) THEN
HelpTopic := pkChoice
ELSE
HelpTopic := wHelpIndex;
SavePkFlags := pkFlags;
SetFlag (pkFlags, pkDrawActive);
RequestHelp (HelpTopic);
pkFlags := SavePkFlags;
END;
CCins, CCdel, ccSelect : {Select}
IF NOT IsSemiProtected (pkChoice) THEN
RaMultipleChoiceCommand := TRUE;
{User exit commands}
ccQuit, ccUser0..$FFFF : RaMultipleChoiceCommand := TRUE;
ELSE
IF (Cmd <= 255) AND (GetExitCommandPtr <> NIL) THEN
{Possibly a special exit command defined by a derived object}
IF (Cmd IN GetExitCommandPtr^) THEN
RaMultipleChoiceCommand := TRUE
ELSE
pkResetSearchStr;
END;
END;
END;
END;
CONSTRUCTOR RaList.Init;
BEGIN
InitAreaManager;
Initabstract (2, 4, 79, ScreenHeight - 9, Cfg.Color [2], {ColorSet to use}
DefWindowOptions + wBordered, {Window options}
80, {Column width per item}
60000, {Number of picklist items}
PickVertical, {Orientation procedure}
SingleChoice);
pkSearcher := PickCharSearch;
pkOptionsOn (pkProcessZero);
Filefinder := RaFindFile;
WITH Cfg.Color [2] DO
BEGIN
SetPickAttr (pkalternate, FALSE, FieldColor, FieldMONO);
SetPickAttr (pkalternate, TRUE, SelFieldColor, SelFieldMono);
END;
ChangeNumItems (0);
Fdbpath := Addbackslash(FdbPath);
RaSelected := 0;
RaSelSize := 0;
RaMask := '*.*';
PkCommand := RaMultipleChoiceCommand;
wFrame.AdjustFrame (1, 2, 80, ScreenHeight - 8);
wFrame.AddHeader ('', heTC);
wFrame.AddHeader ('', HEBL);
wFrame.AddHeader ('', HEBR);
wFrame.AddCUSTOMheader (PAD ('┌── Name ──┐ Size Date DL# Cost Last DL UPdate Flags', 78),
frTL, 1, 1, Cfg.Color [2] .HighlightColor, Cfg.Color [2] .HighlightMono);
MyWin (RaDescWin, 1, ScreenHeight - 7, 80, ScreenHeight - 3, 2, ' Description ', FALSE);
MAXLINES := (MEMAVAIL - 30 * 1024) DIV 200;
END;
destructor RaList.Done;
BEGIN
ERASEHidden;
KillWindow (RaDescWin);
PickList.Done;
FinishAreaManager;
END;
PROCEDURE RaList.ReadDescLine (VAR DESC : STRING; NUM : LONGINT);
VAR
C : CHAR;
ss : STRING;
BEGIN
ss := '';
IF NUM > - 1 THEN
WITH RaTEXTFILE DO
BEGIN
SEEK (NUM);
READ (C, 1);
WHILE (NOT EOF) AND (C <> #0) AND (LENGTH (ss) < 79) DO
BEGIN
ss := ss + C;
READ (C, 1);
END;
END;
DESC := PAD (ss, 80);
END;
PROCEDURE RaList.ReadLnFromMem (VAR DESC : STRING; NUM : LONGINT);
BEGIN
DESC := '';
DESC [0] := CHAR (80);
MOVE (RarPtr [NUM]^.SIZE, DESC [1], 80);
DESC := Trimtrail (DESC);
END;
PROCEDURE RaList.Writeln2Mem (DESC : STRING;
NUM : LONGINT);
BEGIN
DESC := PAD (DESC, 80);
MOVE (DESC [1], RarPtr [NUM]^.SIZE, 80);
END;
PROCEDURE RaList.Editdescline;
VAR
A : BYTE;
C : CHAR;
ss : STRING;
BEGIN
ReadLnFromMem (ss, pkChoice);
IF InputString (3, 7, 79, 65, 3, 'Edit description', 'Desc : ', ss) THEN
BEGIN
IF ss <> '' THEN
BEGIN
C := #0;
RarPtr [pkChoice]^.LONGDESCPTR := RaTEXTFILE.getsize;
IF RarPtr [pkChoice]^.LONGDESCPTR > 0 THEN
BEGIN
RaTEXTFILE.SEEK (RarPtr [pkChoice]^.LONGDESCPTR - 1);
RaTEXTFILE.WriteNoln (#0);
END;
RaTEXTFILE.WriteNoln (ss + #0);
END ELSE
RarPtr [pkChoice]^.LONGDESCPTR := - 1;
RaTEXTFILE.FLUSH;
Writeln2Mem (ss, pkChoice);
END;
END;
PROCEDURE RaList.EditDescField;
VAR
FSize : LONGINT;
F : TbufTextfile;
TempFilename : Pathstr;
editdesc : MemoFile;
C : CHAR;
BEGIN
IF RarPtr [pkChoice]^.LONGDESCPTR > - 1 THEN
BEGIN
RaTEXTFILE.SEEK (RarPtr [pkChoice]^.LONGDESCPTR);
TempFilename := UniqueName (FDBPATH + 'TXT\TMPDESC.TMP');
F.initCreate (TempFilename, SOpenWrite, 2048);
RaTEXTFILE.READ (C, 1);
WHILE NOT RaTEXTFILE.EOF AND NOT (C = #0) DO
BEGIN
F.WRITE (C, 1);
RaTEXTFILE.READ (C, 1);
END;
F.Done;
END;
WITH editdesc DO
BEGIN
InitCustomAndAlloc (9, 8, 72, 18, {Window coordinates}
Cfg.Color [3], {ColorSet}
DefWindowOptions OR wBordered, {Window options}
4096); {Buffer size}
ReadFile (TempFilename, FSize);
{add a header centered at the top of the frame}
wFrame.AddHeader (' Edit description ', heTC);
wFrame.AddShadow (shBR, shSeeThru);
{change the color for control characters}
SetCtrlAttr (Cfg.Color [3] .HighlightColor, Cfg.Color [3] .HighlightMono);
SetHelpIndex (15);
Process;
IF meOptionsAreOn (meModified) AND
Confirm ('Save Description ', 'Y', (ScreenHeight DIV 2) - 3) THEN
BEGIN
SaveFile;
F.initCreate (TempFilename, SOpenread, 2048);
RarPtr [pkChoice]^.LONGDESCPTR := RaTEXTFILE.getsize;
IF RarPtr [pkChoice]^.LONGDESCPTR > 0 THEN
BEGIN
RaTEXTFILE.SEEK (RarPtr [pkChoice]^.LONGDESCPTR - 1);
RaTEXTFILE.WriteNoln (#0);
END;
F.SEEK (0);
F.READ (C, 1);
WHILE NOT F.EOF AND NOT (C = #0) DO
BEGIN
RaTEXTFILE.WRITE (C, 1);
F.READ (C, 1);
END;
RaTEXTFILE.WriteNoln (#0);
F.Done;
END;
DeleteFile (TempFilename);
DeleteFile (COPY (TempFilename, 1, LENGTH (TempFilename) - 3) + 'BAK');
ERASE;
Done;
END;
END;
VAR
FILENAME : STRING [12];
TEMPHDR : FILESHDRRECORD;
PROCEDURE RaList.EDITATTRIBUTES;
CONST
idName = 0;
idDeleted = idName + 1;
idFiledate = idDeleted + 1;
idUnlisted = idFiledate + 1;
idUploaddate = idUnlisted + 1;
idFree = idUploaddate + 1;
idLastDL = idFree + 1;
idMissing = idLastDL + 1;
idUploader = idMissing + 1;
idLocked = idUploader + 1;
idPassword = idLocked + 1;
idNotAvail = idPassword + 1;
idNotime = idNotAvail + 1;
idkeyword = idNotime + 1;
idTimesDl = idkeyword + 1;
idCost = idTimesDl + 1;
idDescription = idCost + 1;
{Help index constants}
CONST
hiName = 1;
hiDeleted = hiName + 1;
hiFiledate = hiDeleted + 1;
hiUnlisted = hiFiledate + 1;
hiUploaddate = hiUnlisted + 1;
hiFree = hiUploaddate + 1;
hiLastDL = hiFree + 1;
hiMissing = hiLastDL + 1;
hiUploader = hiMissing + 1;
hiLocked = hiUploader + 1;
hiPassword = hiLocked + 1;
hiNotAvail = hiPassword + 1;
hiNotime = hiNotAvail + 1;
hikeyword = hiNotime + 1;
hiTimesDl = hikeyword + 1;
hiCost = hiTimesDl + 1;
hiDescription = hiCost + 1;
EsDeleted : BOOLEAN = FALSE;
EsUnlisted : BOOLEAN = FALSE;
EsFree : BOOLEAN = FALSE;
EsMissing : BOOLEAN = FALSE;
EsLocked : BOOLEAN = FALSE;
EsNotAvail : BOOLEAN = FALSE;
EsNotime : BOOLEAN = FALSE;
VAR
AllDone : BOOLEAN;
TempAttr : BYTE;
ES : EntryScreen;
HDRFILE : FILE;
TUPLOADDATE,
TFILEDATE,
TLASTDL : DateTimeRec;
BEGIN
HDRREC := RarPtr [pkChoice]^;
EsDeleted := ByteFlagIsSet (HDRREC.ATTRIB, RaDELETED) ;
EsUnlisted := ByteFlagIsSet (HDRREC.ATTRIB, RaUNLISTED);
EsFree := ByteFlagIsSet (HDRREC.ATTRIB, RaFREE) ;
EsMissing := ByteFlagIsSet (HDRREC .ATTRIB, RaMISSING);
EsLocked := ByteFlagIsSet (HDRREC.ATTRIB, RaLOCKED);
EsNotAvail := ByteFlagIsSet (HDRREC.ATTRIB, RaNOTAVAILABLE);
EsNotime := ByteFlagIsSet (HDRREC.ATTRIB, RaTIME);
PackedToDateTime (HDRREC.UPLOADDATE, TUPLOADDATE);
PackedToDateTime (HDRREC.FILEDATE, TFILEDATE);
PackedToDateTime (HDRREC.LASTDL, TLASTDL);
WITH ES DO
BEGIN
IF NOT InitCustom (2, 3, 79, 21, Cfg.Color [3], wBordered+wClear+wUserContents) THEN
BEGIN
EXIT;
END;
WITH HDRREC DO
BEGIN
FILENAME := NAME;
{idName:}
esFieldOptionsOn (efProtected);
AddStringField ('Filename :', 2, 3, 'XXXXXXXXXXXX', 2, 19, 12, hiName, FILENAME);
esFieldOptionsOff (efProtected);
{idFiledate:}
esFieldOptionsOn (efProtected);
esFieldOptionsOff (efTrimBlanks);
AddDateField ('FileDate :', 3, 3, 'dd-mm-yy', 3, 19, hiFiledate, MinDate, MinDate, TFILEDATE.D);
esFieldOptionsOn (efTrimBlanks);
esFieldOptionsOff (efProtected);
{idUploaddate:}
esFieldOptionsOff (efTrimBlanks);
AddDateField ('Upload date :', 4, 3, 'dd-mm-yy', 4, 19, hiUploaddate, MinDate, MinDate, TUPLOADDATE.D);
{idLastDL:}
AddDateField ('LastDl date :', 5, 3, 'dd-mm-yy', 5, 19, hiLastDL, MinDate, MinDate, TLASTDL.D);
esFieldOptionsOn (efTrimBlanks);
{idUploader:}
AddStringField ('Uploader name :', 6, 3, CharStr ('X', 60), 6, 19, 35, hiUploader, UPLOADER);
{idPassword:}
AddStringField ('Password :', 7, 3, 'XXXXXXXXXXXXXXX', 7, 19, 15, hiPassword, PASSWORD);
{idkeyword:}
AddStringField ('Keyword 1 :', 9, 3, 'XXXXXXXXXXXXXXX', 9, 15, 15, hikeyword, HDRREC.KEYWORD [1]);
{idkeyword:}
AddStringField ('Keyword 2 :', 10, 3, 'XXXXXXXXXXXXXXX', 10, 15, 15, hikeyword, HDRREC.KEYWORD [2]);
{idkeyword:}
AddStringField ('Keyword 3 :', 11, 3, 'XXXXXXXXXXXXXXX', 11, 15, 15, hikeyword, HDRREC.KEYWORD [3]);
{idkeyword:}
AddStringField ('Keyword 4 :', 12, 3, 'XXXXXXXXXXXXXXX', 12, 15, 15, hikeyword, HDRREC.KEYWORD [4]);
{idkeyword:}
AddStringField ('Keyword 5 :', 13, 3, 'XXXXXXXXXXXXXXX', 13, 15, 15, hikeyword, HDRREC.KEYWORD [5]);
{idTimesDl:}
AddWordField ('Times Dled :', 15, 3, '99999', 15, 16, hiTimesDl, 0, 65535, TIMESDL);
{idCost:}
AddWordField ('Cost :', 16, 3, '99999', 16, 16, hiCost, 0, 65535, COST);
(* {idDescription:}
AddNestedStringField ('Edit description <Enter> :', 17, 3, '', 17, 30, 1, hiDescription, Description);*)
{idDeleted:}
esFieldOptionsOn (efClickExit);
AddYesNoField ('Deleted :', 2, 59, 'Y', 2, 70, hiDeleted, EsDeleted);
{idUnlisted:}
AddYesNoField ('Unlisted :', 3, 59, 'Y', 3, 70, hiUnlisted, EsUnlisted);
{idFree:}
AddYesNoField ('Free :', 4, 59, 'Y', 4, 70, hiFree, EsFree);
{idMissing:}
AddYesNoField ('Missing :', 5, 59, 'Y', 5, 70, hiMissing, EsMissing);
{idLocked:}
AddYesNoField ('Locked :', 6, 59, 'Y', 6, 70, hiLocked, EsLocked);
{idNotAvail:}
AddYesNoField ('NotAvail :', 7, 59, 'Y', 7, 70, hiNotAvail, EsNotAvail);
{idNotime:}
AddYesNoField ('NoTime :', 8, 59, 'Y', 8, 70, hiNotime, EsNotime);
esFieldOptionsOff (efClickExit);
END;
AllDone := FALSE;
REPEAT
ES.Process;
{ CASE ES.GetLastCommand OF
ccNested : EditDescField;
END;}
UNTIL ES.GetLastCommand IN [ccError, ccDone, ccQuit];
ES.ERASE;
ES.Done;
TempAttr := 0;
IF EsDeleted THEN SetByteFlag (TempAttr, RaDELETED);
IF EsUnlisted THEN SetByteFlag (TempAttr, RaUNLISTED) ;
IF EsFree THEN SetByteFlag (TempAttr, RaFREE);
IF EsMissing THEN SetByteFlag (TempAttr, RaMISSING);
IF EsLocked THEN SetByteFlag (TempAttr, RaLOCKED);
IF EsNotAvail THEN SetByteFlag (TempAttr, RaNOTAVAILABLE);
IF EsNotime THEN SetByteFlag (TempAttr, RaTIME);
HDRREC.ATTRIB := TempAttr;
DateTimeToPacked (TUPLOADDATE, HDRREC.UPLOADDATE);
DateTimeToPacked (TFILEDATE, HDRREC.FILEDATE);
DateTimeToPacked (TLASTDL, HDRREC.LASTDL);
RarPtr [pkChoice]^ := HDRREC;
END;
END;
PROCEDURE RaList.Insertline (NUM : WORD;
Ask : BOOLEAN);
VAR
i, j : INTEGER;
m : TPoPMenu;
ec,
key : WORD;
Redraw : BOOLEAN;
BEGIN
IF Ralines + 1 > MAXLINES THEN
BEGIN
AskError (8, 'Insufficient memory to insert line', 3);
EXIT;
END;
key := 1;
IF (Ralines > 0) AND Ask THEN
BEGIN
GetMenu (MnuAMInsertLine, 3, m);
m.ProcessMenu (key, ec);
END ELSE
ec := ccNone;
IF ec <> ccQuit THEN
BEGIN
j := 0;
IF Ralines < MAXLINES THEN
BEGIN
INC (Ralines);
New(RarPtr[Ralines]);
IF Ralines > 1 THEN
BEGIN
IF key = 1 THEN j := 0 ELSE j := 1;
FOR i := Ralines - 1 DOWNTO NUM + j DO
RarPtr [i + 1]^ := RarPtr [i]^;
END;
END;
FILLCHAR (RarPtr [NUM + j]^, SIZEOF (FILESHDRRECORD), #0);
RarPtr [NUM + j]^.LONGDESCPTR := - 1;
ChangeNumItems (Ralines);
END;
END;
CONST
DeleteALL : BOOLEAN = FALSE;
PROCEDURE RaList.DeleteOneLine (Ask, Del : BOOLEAN;
NUM : WORD);
VAR
sr : SEARCHREC;
D : BOOLEAN;
i : WORD;
TempNAME : S12;
Redraw : BOOLEAN;
BEGIN
D := Del;
WITH RarPtr [NUM]^ DO
BEGIN
IF (NAME <> '') AND (WritableFile (addbackslash (Area^ [CurrentArea]^.path^) + NAME) ) AND
ExistFile (Area^ [CurrentArea]^.path^ + NAME) THEN
BEGIN
IF DeleteALL THEN
D := TRUE ELSE
IF Ask THEN
BEGIN
CASE ConfirmAll (' Delete ' + NAME + ' also?', 6) OF
'Y' : D := TRUE;
'N' : D := FALSE;
'A' : BEGIN
DeleteALL := TRUE;
D := TRUE;
END;
END;
IF D THEN
BEGIN
FINDFIRST (NAME, AnyFile, sr);
WHILE DOSERROR = 0 DO
BEGIN
DeleteFile(sr.NAME);
FINDNEXT(sr);
END;
FindClose(sr);
END;
END;
END;
FOR i := NUM TO Ralines - 1 DO
RarPtr [i]^ := RarPtr [i + 1]^;
Dispose(RarPtr[Ralines]);
END;
DEC (Ralines);
ChangeNumItems (Ralines);
{Move the highlight bar if forced to}
IF pkChoice > Ralines THEN
BEGIN
pkChoice := Ralines;
IF Ralines > 0 THEN
SetInitialChoice (pkChoice);
END;
END;
PROCEDURE RaList.Deleteline (Ask : BOOLEAN);
VAR
Del : BOOLEAN;
j : WORD;
SellectedItem : WORD;
BEGIN
Del := NOT Ask;
IF Ask THEN
IF RaSelected = 0 THEN
Del := Confirm ('Delete current line', 'Y', 5)
ELSE
Del := Confirm ('Delete MARKED lines', 'N', 5);
DeleteALL := FALSE;
IF Del THEN
BEGIN
IF RaSelected > 0 THEN
BEGIN
j := 1;
REPEAT
IF BOOLEAN (RarPtr [j]^.FREESPACE [20]) THEN
BEGIN
IF Ralines > 0 THEN
DeleteOneLine (Ask, Del, j)
END
ELSE
INC (j);
UNTIL j > Ralines;
RaClearSelected;
END
ELSE
IF Ralines > 0 THEN
DeleteOneLine (Ask, Del, pkChoice);
END;
END;
PROCEDURE RaList.TouchFile;
VAR
l : LONGINT;
dofw, Sec100 : WORD;
Dt : DateTime;
F : FILE;
SellectedItem : WORD;
BEGIN
WITH Dt DO
BEGIN
GETTIME (Hour, Min, Sec, Sec100);
GETDATE (Year, Month, Day, dofw);
END;
PACKTIME (Dt, l);
IF RaSelected = 0 THEN
BOOLEAN (RarPtr [pkChoice]^.FREESPACE [20]) := TRUE;
FOR SellectedItem := 1 TO Ralines DO
BEGIN
IF (BOOLEAN (RarPtr [SellectedItem]^.FREESPACE [20]) ) AND (RarPtr [SellectedItem]^.NAME <> '') THEN
BEGIN
ASSIGN (F, RarPtr [SellectedItem]^.NAME);
FileMode := ShareRead + ShareDenyW;
RESET (F);
IF IORESULT = 0 THEN
BEGIN
RarPtr [SellectedItem]^.FILEDATE := l;
SETFTIME (F, l);
CLOSE (F);
END;
END;
END;
RaClearSelected;
END;
PROCEDURE RaList.MoveFileInSameArea;
VAR
TEMPREC : FILESHDRRECORD;
i,
TTO,
From,
key : WORD;
BEGIN
Information('MOVE MODE: F-Keys disabled. Hit RETURN to finish.');
From := pkChoice;
REPEAT
Process;
key := GETLASTKEY;
CASE GETLASTKEY OF
Enter : BEGIN
TEMPREC := RarPtr [From]^;
TTO := pkChoice;
DeleteOneLine (FALSE, FALSE, From);
Insertline (TTO, FALSE);
RarPtr [TTO]^ := TEMPREC;
END;
END;
UNTIL (key = Enter) OR (key = Esc);
Information ('');
END;
PROCEDURE RaList.Moveline;
VAR
m : TPoPMenu;
sd : CHAR;
key : INTEGER;
PROCEDURE MoveFileToOtherArea (KEEP, InFileArea : BOOLEAN);
LABEL
Slut, Skip, DoTheMove, MoveTheText;
VAR
Go, All : BOOLEAN;
OldAreaLine,
OldTopArea, j : WORD;
GemTekst, Fp,
s, ss, DestPath : STRING;
Othertxtfile : TbufTextfile;
OtherHDRFILE,
OtherIDXFILE : TNetFile;
Escaped : BOOLEAN;
m : TPoPMenu;
OldArea,
key, Inkey : WORD;
PROCEDURE MoveAll_Info_on_file;
VAR
C : CHAR;
FZ : LONGINT;
IDXREC : FILESIDXRECORD;
BEGIN
IF InFileArea THEN
BEGIN
RarPtr [j]^.FREESPACE [20] := 0;
HDRREC := RarPtr [j]^;
IF HDRREC.LONGDESCPTR > - 1 THEN
BEGIN
HDRREC.LONGDESCPTR := Othertxtfile.getsize;
RaTEXTFILE.SEEK (RarPtr [j]^.LONGDESCPTR);
IF HDRREC.LONGDESCPTR > 0 THEN
BEGIN
Othertxtfile.SEEK (HDRREC.LONGDESCPTR - 1);
Othertxtfile.WriteNoln (#0);
END;
RaTEXTFILE.READ (C, 1);
WHILE NOT RaTEXTFILE.EOF AND NOT (C = #0) DO
BEGIN
Othertxtfile.WRITE (C, 1);
RaTEXTFILE.READ (C, 1);
END;
Othertxtfile.WriteNoln (#0);
END;
OtherHDRFILE.SEEK(OtherHDRFILE.FILESIZE);
OtherHDRFILE.Write(HDRREC);
OtherIDXFILE.SEEK(OtherIDXFILE.FILESIZE);
FILLCHAR (IDXREC, SIZEOF (FILESIDXRECORD), #0);
IDXREC.NAME := HDRREC.NAME;
IDXREC.UPLOADDATE := HDRREC.UPLOADDATE;
IDXREC.LONGDESCPTR := HDRREC.LONGDESCPTR;
OtherIDXFILE.Write(IDXREC);
END;
IF NOT KEEP THEN
DeleteOneLine (FALSE, FALSE, j);
END;
BEGIN
j := 1;
OldArea := CurrentArea;
OldTopArea := TopArea;
OldAreaLine := AreaLine;
IF InFileArea THEN
BEGIN
Escaped := NOT ChooseFileArea (Inkey);
DestPath := Area^ [CurrentArea]^.path^;
AreaLine := OldAreaLine;
TopArea := OldTopArea;
ChangeDir (Area^ [OldArea]^.path^);
IF Escaped THEN
GOTO Slut;
END ELSE
BEGIN
DestPath := 'A:';
IF NOT SelectPath (DestPath) THEN
GOTO Slut;
END;
IF ( (CurrentArea <> OldArea) OR NOT InFileArea) THEN
BEGIN {5}
IF RaSelected = 0 THEN
BOOLEAN (RarPtr [pkChoice]^.FREESPACE [20]) := TRUE;
IF InFileArea THEN
BEGIN
Othertxtfile.initCreate (FDBPATH + 'TXT\fdb' + Long2str (CurrentArea) + '.TXT',
SOpenWrite, 2048);
OtherHDRFILE.Open(FDBPATH + 'HDR\fdb' + Long2str (CurrentArea) + '.HDR', SIZEOF (HDRREC),
NOT ExistFile (FDBPATH + 'HDR\fdb' + Long2str (CurrentArea) + '.HDR') );
OtherIDXFILE.Open(FDBPATH + 'IDX\fdb' + Long2str (CurrentArea) + '.IDX', SIZEOF (FILESIDXRECORD),
NOT ExistFile (FDBPATH + 'IDX\fdb' + Long2str (CurrentArea) + '.IDX') );
END;
All := FALSE;
Go := TRUE;
j := 1;
REPEAT
IF BOOLEAN (RarPtr [j]^.FREESPACE [20]) THEN
BEGIN {3}
s := RarPtr [j]^.NAME;
{ S er et filnavn og filen findes i det nye område }
IF (s <> '') AND (ExistFile (addbackslash (DestPath) + s) )
AND (ExistFile (Area^ [OldArea]^.path^ + s) ) THEN
BEGIN {1}
IF NOT All THEN
BEGIN {2}
CASE ConfirmAll ('Overwrite existing file "' + s + '" ?', 8) OF
'Y' : Go := TRUE;
'N' : Go := FALSE;
'A' : BEGIN
Go := TRUE;
All := TRUE;
END;
END;
END; {2}
END; {1}
IF (s <> '') AND (Go) AND (ExistFile (Area^ [OldArea]^.path^ + s) ) THEN
BEGIN {4}
DoTheMove :
{IF (COPY (Area^ [OldArea]^.path^, 1, 1) = COPY (DestPath, 1, 1) ) THEN
DeleteFile (addbackslash (DestPath) + s);}
io := CopyFile (Area^ [OldArea]^.path^ + s, addbackslash (DestPath) + s, FALSE, NOT KEEP);
IF io <> 0 THEN
BEGIN
CASE io OF
5 : ss := 'No Room for ' + JustFileName (s);
152 : ss := 'Drive not ready';
162 : ss := 'General failure';
ELSE
ss := 'Unknown error #' + Long2str (io);
END;
GetMenu (MnuCopyFileError, 3, m);
m.wFrame.AddHeader (' ' + ss + ' ', heTC);
m.Draw;
m.Process;
key := m.MenuChoice;
IF m.GetLastCommand = ccQuit THEN
key := 2;
m.Done;
CASE key OF
1 : GOTO DoTheMove;
2 : GOTO Slut;
3 : GOTO Skip;
END;
END; {4}
END; {5}
MoveAll_Info_on_file;
Skip :
IF KEEP OR (io = 5) THEN
INC (j);
END
ELSE
INC (j);
UNTIL j > Ralines;
Slut :
IF InFileArea THEN
BEGIN
CurrentArea := OldArea;
Othertxtfile.Done;
OtherHDRFILE.Close;
OtherIDXFILE.Close;
END;
END;
RaClearSelected;
END;
BEGIN
GetMenu (MnuAMMoveFile, 3, m);
IF GetDiskClass (Area^ [CurrentArea]^.path^ [1], sd) = CDRomDisk THEN
BEGIN
m.ProtectItem (1);
m.ProtectItem (2);
END;
IF (RaSelected > 1) OR
(GetDiskClass (Area^ [CurrentArea]^.path^ [1], sd) = CDRomDisk) THEN
m.ProtectItem (5);
m.Draw;
m.Process;
key := m.MenuChoice;
m.ERASE;
IF m.GetLastCommand <> ccQuit THEN
BEGIN
CASE key OF
1..4 : MoveFileToOtherArea (key IN [3, 4], key IN [1, 3]);
5 : MoveFileInSameArea;
END;
END;
m.Done;
END;
PROCEDURE RaList.RaQuickSort (First, Last : WORD);
VAR
i, j : WORD;
x : S12;
Y : POINTER;
BEGIN
i := First;
j := Last;
x := RarPtr [ (First + Last) DIV 2]^.NAME;
REPEAT
WHILE RarPtr [i]^.NAME < x DO
i := i + 1;
WHILE x < RarPtr [j]^.NAME DO
j := j - 1;
IF i <= j THEN
BEGIN
Y := RarPtr [i];
RarPtr [i] := RarPtr [j];
RarPtr [j] := Y;
INC (i);
DEC (j);
END;
UNTIL i > j;
IF First < j THEN
RaQuickSort (First, j);
IF i < Last THEN
RaQuickSort (i, Last);
END;
PROCEDURE RaList.RaSortFiles;
VAR
ALo, AHI : WORD;
NUM,
First, Last,
i, j : WORD;
s, LastUsed, Smallest : S13;
BEGIN {quicksort}
IF RaSelected = 2 THEN
BEGIN
First := 1;
WHILE NOT BOOLEAN (RarPtr [First]^.FREESPACE [20]) DO
INC (First);
IF RarPtr [First]^.NAME = '' THEN
BEGIN
AskError (8, 'First line MUST contain a file name', 3);
EXIT;
END;
Last := First + 1;
WHILE NOT BOOLEAN (RarPtr [Last]^.FREESPACE [20]) DO
INC (Last);
j := First;
WHILE (j <= Last) DO
BEGIN
WHILE (j <= Last) AND (RarPtr [j]^.NAME <> '') DO
INC (j);
RaQuickSort (First, j - 1);
INC (j);
WHILE (j <= Last) AND (RarPtr [j]^.NAME = '') DO
INC (j);
First := j;
END;
RaClearSelected;
END;
END;
VAR
SelectedHdrIndex : BYTE;
FUNCTION RaList.RaLoadfiles : BOOLEAN;
VAR
HDRFILE : TNetFile;
Redraw : BOOLEAN;
WaitWin : PWait;
Tempstr : STRING;
C : CHAR;
T,
TXTBUF : LONGINT;
BEGIN
New(WaitWin, Init(5, 3, 'Scanning for files'));
{ ******************* ......... *** Rettes til en var }
HDRFILE.Open(FDBPATH + 'HDR\fdb' + Long2str (CurrentArea) + '.HDR', SIZEOF (HDRREC),
NOT ExistFile (FDBPATH + 'HDR\fdb' + Long2str (CurrentArea) + '.HDR') );
T := MAXAVAIL - (HDRFILE.FILESIZE * 194);
IF T > $FFFF THEN
TXTBUF := 20 * 1024
ELSE
BEGIN
TXTBUF := T - 10 * 1024;
IF TXTBUF < 0 THEN TXTBUF := 1024;
END;
RaTEXTFILE.initCreate ( FDBPATH + 'TXT\fdb' + Long2str (CurrentArea) + '.TXT', Sopen, TXTBUF);
Rafiles := 0;
RaSelected := 0;
RaSelSize := 0;
Ralines := 0;
Rasize := 0;
RaLoadfiles := TRUE;
WHILE NOT HDRFILE.EOF AND (Ralines <= MAXLINES) AND (MAXAVAIL > 10240) DO
BEGIN
HDRFILE.Read(HDRREC, NoKeep, Wait);
INC (Ralines);
New(RarPtr [Ralines]);
IF RarPtr[Ralines]=NIL THEN
BEGIN
RaLoadfiles := FALSE;
Break;
END;
RarPtr [Ralines]^ := HDRREC;
BOOLEAN (RarPtr [Ralines]^.FREESPACE [20]) := FALSE;
IF (HDRREC.NAME <> '') THEN
BEGIN
IF NOT ExistFile (addbackslash (Area^ [CurrentArea]^.path^) + HDRREC.NAME) THEN
RarPtr [Ralines]^ .FREESPACE [1] := 1
ELSE
BEGIN
Rasize := Rasize + HDRREC.SIZE;
INC (Rafiles);
{ClearByteFlag (RarPtr [Ralines]^ .Attrib, RaMISSING)}
END;
END ELSE
BEGIN
ReadDescLine (Tempstr, HDRREC.LONGDESCPTR);
Tempstr := PAD (Tempstr, 80);
MOVE (Tempstr [1], RarPtr [Ralines]^.SIZE, 80);
END;
WaitWin^.Animate;
END;
HDRFILE.Close;
Dispose(WaitWin, Done);
IF Ralines > MAXLINES THEN
BEGIN
RaLoadfiles := FALSE;
RaTEXTFILE.Done;
END ELSE
ChangeNumItems (Ralines);
IF Cfg.Areaman.AdoptDefault AND NOT AdoptOrphans(TRUE, FALSE) THEN RaLoadfiles := FALSE;
TotalHeader;
END;
PROCEDURE RaList.RaWritefiles;
VAR
IDXFILE : TNetFile;
HDRFILE : FILE;
TIDXFILE : TNetFile;
THDRFILE : TNetFile;
WaitWin : PWait;
IDXREC : FILESIDXRECORD;
A : INTEGER;
RAERASEFILES : BOOLEAN;
HS, IS : STRING;
BEGIN
New(WaitWin, Init(5, 3, 'Savning files'));
HS := UniqueName (FDBPATH + 'HDR\fdb' + Long2str (CurrentArea) + '.HDR');
THDRFILE.Open(HS, SIZEOF (HDRREC), TRUE);
IS := UniqueName (FDBPATH + 'IDX\fdb' + Long2str (CurrentArea) + '.IDX');
TIDXFILE.Open(IS, SIZEOF (HDRREC), TRUE);
IDXFILE.Open(FDBPATH + 'IDX\fdb' + Long2str (CurrentArea) + '.IDX', SIZEOF (IDXREC),
NOT ExistFile (FDBPATH + 'IDX\fdb' + Long2str (CurrentArea) + '.IDX') );
FOR A := 1 TO Ralines DO
BEGIN
RarPtr [Ralines]^ .FREESPACE [1] := 0;
RarPtr [Ralines]^.FREESPACE [20] := 0;
THDRFILE.PutRec(RarPtr [A]^, A - 1);
IDXREC.NAME := RarPtr [A]^.NAME;
IDXREC.UPLOADDATE := RarPtr [A]^.UPLOADDATE;
IDXREC.LONGDESCPTR := RarPtr [A]^.LONGDESCPTR;
TIDXFILE.PutRec(IDXREC, A - 1);
Dispose(RarPtr[A]);
WaitWin^.Animate;
END;
RAERASEFILES := TIDXFILE.FILESIZE= 0;
IDXFILE.Close;
TIDXFILE.Close;
THDRFILE.Close;
RaTEXTFILE.Done;
IF RAERASEFILES THEN
BEGIN
DeleteFile (FDBPATH + 'HDR\fdb' + Long2str (CurrentArea) + '.HDR');
DeleteFile (FDBPATH + 'IDX\fdb' + Long2str (CurrentArea) + '.IDX');
DeleteFile (FDBPATH + 'TXT\fdb' + Long2str (CurrentArea) + '.TXT');
DeleteFile (HS);
DeleteFile (IS);
END ELSE
BEGIN
DeleteFile (FDBPATH + 'HDR\fdb' + Long2str (CurrentArea) + '.HDR');
DeleteFile (FDBPATH + 'IDX\fdb' + Long2str (CurrentArea) + '.IDX');
RenameFile (HS, FDBPATH + 'HDR\fdb' + Long2str (CurrentArea) + '.HDR');
RenameFile (IS, FDBPATH + 'IDX\fdb' + Long2str (CurrentArea) + '.IDX');
END;
Dispose(WaitWin, Done);
RaClearSelected;
Clear;
END;
PROCEDURE RaList.RaDelocatefiles;
VAR
A : INTEGER;
BEGIN
FOR A := 1 TO Ralines DO
Dispose(RarPtr[A]);
RaClearSelected;
Clear;
RaTEXTFILE.Done;
END;
PROCEDURE RaList.RenameLine;
VAR
s, ss : S13;
BEGIN
s := RarPtr [pkChoice]^.NAME;
IF s <> ''THEN
BEGIN
IF InputString (30, 8, 12, 12, 3, 'Rename file', 'FileName : ', s)
AND (s <> RarPtr [pkChoice]^.NAME) THEN
BEGIN
s := StUpCase (s);
IF RenameFile (RarPtr [pkChoice]^.NAME, s) THEN
RarPtr [pkChoice]^.NAME := s;
END;
end;
END;
PROCEDURE RaList.TouchAllFiles;
VAR
F : FILE;
i : INTEGER;
l : LONGINT;
Dt : DateTime;
Sec100,
dofw : WORD;
BEGIN
IF Confirm ('Touch ALL files >', 'Y', 5) THEN
BEGIN
WITH Dt DO
BEGIN
GETTIME (Hour, Min, Sec, Sec100);
GETDATE (Year, Month, Day, dofw);
END;
PACKTIME (Dt, l);
FOR i := 1 TO Ralines DO
BEGIN
RarPtr [i]^.FILEDATE := l;
ASSIGN (F, RarPtr [i]^.NAME);
FileMode := ShareRead + ShareDenyW;
RESET (F);
SETFTIME (F, l);
CLOSE (F);
END;
END;
END;
FUNCTION RaList.AdoptOrphans (Silent, EnterUploader : BOOLEAN) : BOOLEAN;
VAR
inf : WORD;
i, NUM : INTEGER;
DirInfo : SEARCHREC;
s : STRING [35];
BEGIN
AdoptOrphans := TRUE;
IF Silent OR Confirm ('Adopt ALL orphans in this area >', 'Y', 9) THEN
BEGIN
s := Cfg.Sysop;
IF EnterUploader THEN InputString (5, 8, 35, 50, 3, 'Uploader', 'Name : ', s);
inf := Ralines;
NUM := 0;
FINDFIRST ('*.*', Archive, DirInfo);
WHILE DOSERROR = 0 DO
BEGIN
i := 1;
WHILE NOT (RarPtr [i]^.NAME = DirInfo.NAME) AND (i <= Ralines) DO
INC (i);
IF RarPtr [i]^.NAME <> DirInfo.NAME THEN
BEGIN
IF i <= Ralines THEN INC (i);
INC (Ralines);
INC (Rafiles);
New(RarPtr[Ralines]);
IF (MAXLINES < Ralines) OR
(MAXAVAIL < 10240) OR
(RarPtr[Ralines]=NIL) THEN
BEGIN
AdoptOrphans := FALSE;
DEC (Ralines);
DEC (Rafiles);
ChangeNumItems (Ralines);
EXIT;
END;
INC (NUM);
FILLCHAR (RarPtr [Ralines]^, SIZEOF (FILESHDRRECORD), #0);
WITH DirInfo DO
BEGIN
RarPtr [Ralines]^.NAME := NAME;
RarPtr [Ralines]^.SIZE := SIZE;
RarPtr [Ralines]^.FILEDATE := time;
RarPtr [Ralines]^.UPLOADDATE := time;
END;
RarPtr [Ralines]^.UPLOADER := s;
RarPtr [Ralines]^.LONGDESCPTR := - 1;
END;
FINDNEXT (DirInfo);
END;
FindClose(DirInfo);
ChangeNumItems (Ralines);
IF inf = 0 THEN INC (inf);
IF Ralines > 0 THEN RaQuickSort (inf, Ralines);
IF NOT Silent THEN UserInformation (8, Long2str (NUM) + ' file(s) adopted', 3, 1);
TotalHeader;
END;
END;
PROCEDURE RaList.ResetDownloadCounters;
VAR
i : WORD;
BEGIN
IF Confirm ('Reset ALL download counters in this area', 'N', 8) THEN
FOR i := 1 TO Ralines DO
RarPtr [i]^.TIMESDL := 0;
END;
PROCEDURE RaList.GlobalCommands;
VAR
m : TPoPMenu;
key,
LastCmd : WORD;
BEGIN
IF NOT WritableFile (Area^ [CurrentArea]^.path^) AND
NOT WritableFile (Area^ [CurrentArea]^.FPath^) THEN
EXIT;
GetMenu (MnuAMGlobalFunc, 3, m);
IF NOT WritableFile (Area^ [CurrentArea]^.FPath^) THEN
BEGIN
FOR LastCmd := 1 TO 6 DO
IF NOT (LastCmd <> 2) THEN
m.ProtectItem (LastCmd);
END;
IF NOT WritableFile (Area^ [CurrentArea]^.path^) THEN
m.ProtectItem (2);
m.ProtectItem (3);
m.ProtectItem (5);
m.ProtectItem (6);
m.ProcessMenu (key, LastCmd);
IF LastCmd <> ccQuit THEN
BEGIN
CASE key OF
1 : AdoptOrphans (FALSE, TRUE);
2 : TouchAllFiles;
{ 3 : DeleteDownloadCounters;}
4 : ResetDownloadCounters;
{ 5 : InsertDownLoadCounters(FALSE);
6 : ReAllignDownloadCounters(FALSE);}
END;
END;
END;
PROCEDURE RaList.SendFilesToNode;
VAR
ch : CHAR;
m : BYTE;
Escaped : BOOLEAN;
i : WORD;
SendAddress : TFidoAddress;
s : STRING;
BEGIN
FILLCHAR (SendAddress, SIZEOF (SendAddress), 0);
IF RaSelected = 0 THEN
BOOLEAN (RarPtr [pkChoice]^.FREESPACE [20]) := TRUE;
NodeListPathStr := #255;
InitialiseNodeList (Cfg.NodeList, Cfg.NodeListTyp);
IF GetConfirmAddress (3, 4, SendAddress, 1503) THEN
BEGIN
m := SelectMailType (Escaped, 1550);
IF NOT Escaped THEN
BEGIN
ExtFlags [1] := 'H';
ExtFlags [3] := 'F';
ch := ExtFlags [m];
FOR i := 1 TO Ralines DO
IF (BOOLEAN (RarPtr [i]^.FREESPACE [20]) ) AND (RarPtr [i]^.NAME <> '') THEN
SendAFile (Area^ [CurrentArea]^.path^ + RarPtr [i]^.NAME, SendAddress, ch, STNothing);
END;
END;
FreeUpMemory;
END;
PROCEDURE RaList.HatchFiles;
VAR
i : WORD;
BEGIN
FOR i := 1 TO Ralines DO
IF (BOOLEAN (RarPtr [i]^.FREESPACE [20]) ) AND
(RarPtr [i]^.NAME <> '') THEN
Hatch (Area^ [CurrentArea]^.path^ + RarPtr [i]^.NAME, '');
END;
PROCEDURE RaList.Centerline;
VAR
A : BYTE;
C : CHAR;
ss : STRING;
BEGIN
ReadLnFromMem (ss, pkChoice);
ss := Trimtrail (Center (TRIM (ss), 79) );
IF ss <> '' THEN
BEGIN
RarPtr [pkChoice]^.LONGDESCPTR := RaTEXTFILE.getsize;
IF RarPtr [pkChoice]^.LONGDESCPTR > 0 THEN
BEGIN
RaTEXTFILE.SEEK (RarPtr [pkChoice]^.LONGDESCPTR - 1);
RaTEXTFILE.WriteNoln (#0);
END
ELSE
RaTEXTFILE.SEEK (0);
RaTEXTFILE.WriteNoln (ss + #0);
END
ELSE
RarPtr [pkChoice]^.LONGDESCPTR := - 1;
Writeln2Mem (ss, pkChoice);
END;
PROCEDURE RaList.Joinlines;
VAR
C : CHAR;
Dss,
Dss2 : STRING;
BEGIN
ReadLnFromMem (Dss, pkChoice);
ReadLnFromMem (Dss2, pkChoice + 1);
{ skriv den sammenlagte description og fjern den anden}
IF LENGTH (Dss) + LENGTH (Dss2) < 79 THEN
BEGIN
Dss := Dss + Dss2;
RarPtr [pkChoice]^.LONGDESCPTR := RaTEXTFILE.getsize;
IF RarPtr [pkChoice]^.LONGDESCPTR > 0 THEN
BEGIN
RaTEXTFILE.SEEK (RarPtr [pkChoice]^.LONGDESCPTR - 1);
RaTEXTFILE.WriteNoln (#0);
END
ELSE
RaTEXTFILE.SEEK (0);
RaTEXTFILE.WriteNoln (Dss + #0);
Writeln2Mem (Dss, pkChoice);
DeleteOneLine (FALSE, FALSE, pkChoice + 1);
END;
END;
PROCEDURE RaList.ViewGIF;
VAR
s : S13;
ss : STRING;
BEGIN
s := RarPtr [pkChoice]^.NAME;
IF (s <> '') AND (TrimSpaces (Cfg.Areaman.ViewCMD) <> '') THEN
BEGIN
ss := Cfg.Areaman.ViewCMD;
Replace (ss, '$filename', s, 0);
RunCmd (ss, '');
END;
END;
PROCEDURE RaList.ImportDescription;
VAR
s : S13;
ss : STRING;
IMPFILE : TbufTextfile;
C : CHAR;
i : INTEGER;
SellectedItem : Word;
BEGIN
s := 'File_id.diz';
IF InputString (5, 8, 35, 50, 3, 'Import Description from Archive', 'FileName : ', s) THEN
BEGIN
IF RaSelected = 0 THEN
BOOLEAN (RarPtr [pkChoice]^.FREESPACE [20]) := TRUE;
FOR SellectedItem := 1 TO Ralines DO
BEGIN
IF (BOOLEAN (RarPtr [SellectedItem]^.FREESPACE [20]) ) AND (RarPtr [SellectedItem]^.NAME <> '') THEN
BEGIN
i := ArcType (RarPtr [SellectedItem]^.NAME);
IF i > 0 THEN
Begin
{ss := Cfg.packer [i] .UnPackCmd;
Replace (ss, '$filespec', s, 0);
Replace (ss, '$archive', RarPtr [SellectedItem]^.NAME, 0);
RunCmd (ss, '');}
IF ArcCommand(i, 2, Fexpand(RarPtr [SellectedItem]^.NAME), s)
AND ExistFile (s) THEN
BEGIN
IMPFILE.Init (s, Sopen, 1024);
RarPtr [SellectedItem]^.LONGDESCPTR := RaTEXTFILE.getsize;
IF RarPtr [SellectedItem]^.LONGDESCPTR > 0 THEN
BEGIN
RaTEXTFILE.SEEK (RarPtr [SellectedItem]^.LONGDESCPTR - 1);
RaTEXTFILE.WriteNoln (#0);
END;
IMPFILE.READ (C, 1);
WHILE NOT IMPFILE.EOF DO
BEGIN
RaTEXTFILE.WRITE (C, 1);
IMPFILE.READ (C, 1);
END;
IMPFILE.Done;
DeleteFile (s);
END;
END;
END;
END;
RaClearSelected;
END;
END;
Procedure Ralist.Reverse_Select;
VAR
I : WORD;
Begin
FOR I := 1 TO RALINES DO
BOOLEAN (RarPtr [I]^.FREESPACE [20]) := NOT BOOLEAN (RarPtr [I]^.FREESPACE [20]);
END;
FUNCTION WildComp(wild,name:string):boolean;
BEGIN
WildComp:=FALSE;
if name = '' then exit;
CASE wild[1] of
'*' : BEGIN
if name[1]='.' then exit;
if length(wild)=1 then WildComp:=TRUE;
if (length(wild) > 1) and (wild[2]='.') and (length(name) > 0)
then WildComp:=WildComp(copy(wild,3,length(wild)-2),
copy(name,pos('.',name)+1,length(name)-pos('.',name)));
END;
'?': BEGIN
if ord(wild[0])=1
then WildComp:=TRUE
else WildComp:=WildComp(copy(wild,2,length(wild)-1),
copy(name,2,length(name)-1));
END;
ELSE if name[1] = wild[1]
then if length(wild) > 1
then WildComp:=WildComp(copy(wild,2,length(wild)-1),
copy(name,2,length(name)-1))
else if (length(name)=1)
and (length(wild)=1)
then WildComp:=TRUE
else WildComp:=FALSE;
END;
END;
Procedure Ralist.MenuSelect(MarkLine : Boolean);
VAR
I : WORD;
S : String;
Begin
IF MArkline THEN S := 'Select' ELSE S := 'Deselect';
IF InputString (30, 8, 12, 12, 3, S, 'Mask : ', RaMASK) THEN
FOR I := 1 TO RALINES DO
IF WildComp(Stupcase(RaMASK),Stupcase(RarPtr[I]^.name)) THEN
BOOLEAN (RarPtr [I]^.FREESPACE [20]) := MArkline;
END;
PROCEDURE RaList.TotalHeader;
VAR
A : WORD;
Redraw : BOOLEAN;
BEGIN
Rafiles := 0;
Rasize := 0;
FOR A := 1 TO Ralines DO
BEGIN
IF (RarPtr [A]^.NAME <> '') AND (RarPtr [A]^.FREESPACE [1] = 0) THEN
BEGIN
INC (Rafiles);
INC (Rasize, RarPtr [A]^.SIZE);
END;
END;
wFrame.ChangeHeaderString (1, ' Files : ' + longintform ('#####', Rafiles) +
' Bytes : ' + longintform ('###,###,###', Rasize) + ' ', Redraw);
{ **** DEBUG ***********}
{ wFrame.ChangeHeaderString (1, ' Files : ' + longintform ('#####', Maxlines) +
' Bytes : ' + longintform ('###,###,###', Memavail) + ' ', Redraw); }
IF Redraw THEN
wFrame.UpDateFrame ELSE
wFrame.DrawHeader (1);
END;
PROCEDURE RaList.SelectedHeader;
VAR
A : WORD;
Redraw : BOOLEAN;
BEGIN
RaSelected := 0;
RaSelSize := 0;
FOR A := 1 TO Ralines DO
IF BOOLEAN (RarPtr [A]^.FREESPACE [20]) THEN
BEGIN
INC (RaSelected);
IF (RarPtr [A]^.NAME <> '') AND (RarPtr [A]^.FREESPACE [1] = 0) THEN
RaSelSize := RaSelSize + RarPtr [A]^.SIZE;
END;
wFrame.ChangeHeaderString (2, ' Marked lines : ' + longintform ('#####', RaSelected) +
' Bytes :' + longintform ('###,###,###', RaSelSize) + ' ', Redraw);
IF Redraw THEN
wFrame.UpDateFrame ELSE
wFrame.DrawHeader (2);
END;
PROCEDURE RaList.RaClearSelected;
VAR
A : WORD;
BEGIN
FOR A := 1 TO Ralines DO
BOOLEAN (RarPtr [A]^.FREESPACE [20]) := FALSE;
END;
{$F+}
PROCEDURE RaList.ItemString (Item : WORD; Mode : pkMode; VAR IType : pkItemType;
VAR IString : STRING);
VAR
Dt : DateTimeRec;
C : CHAR;
Tempst : STRING [8];
BEGIN
WITH RarPtr [Item]^ DO
BEGIN
IF NAME <> '' THEN
BEGIN
PackedToDateTime (FILEDATE, Dt);
IString := (PAD (NAME, 12) );
IF FREESPACE [1] = 0 THEN
IString := IString + ' ' + longintform ('#########', SIZE) + ' ' +
DateToDateString ('dd-mm-yy', Dt.D)
ELSE
IString := IString + Center ('Missing', 21);
IString := IString + ' [' + longintform ('@@@@@', TIMESDL) + ']';
IString := IString + ' ' + longintform ('#####', COST);
PackedToDateTime (UPLOADDATE, Dt);
IString := IString + ' ' + DateToDateString ('dd-mm-yy', Dt.D);
PackedToDateTime (LASTDL, Dt);
IString := IString + ' ' + DateToDateString ('dd-mm-yy', Dt.D);
Tempst := '-------';
IF ByteFlagIsSet (ATTRIB, RaDELETED) THEN
Tempst [1] := 'D';
IF ByteFlagIsSet (ATTRIB, RaUNLISTED) THEN
Tempst [2] := 'U';
IF ByteFlagIsSet (ATTRIB, RaFREE) THEN
Tempst [3] := 'F';
IF ByteFlagIsSet (ATTRIB, RaNOTAVAILABLE) THEN
Tempst [4] := 'N';
IF ByteFlagIsSet (ATTRIB, RaLOCKED) THEN
Tempst [5] := 'L';
IF ByteFlagIsSet (ATTRIB, RaMISSING) THEN
Tempst [6] := 'M';
IF ByteFlagIsSet (ATTRIB, RaTIME) THEN
Tempst [7] := 'T';
IString := IString + ' ' + Tempst;
END
ELSE
BEGIN
IString := '';
IString [0] := CHAR (80);
MOVE (RarPtr [Item]^.SIZE, IString [1], 80);
END;
IF BOOLEAN (RarPtr [Item]^.FREESPACE [20]) THEN
IType := pkalternate;
END;
END;
{$F+}
PROCEDURE RaList.Writedescription_To_window (LONGDESCPTR : LONGINT);
VAR
LINE : BYTE;
C : CHAR;
BEGIN
FILLCHAR (Desclines , SIZEOF (Desclines), #0);
LINE := 1;
IF LONGDESCPTR > - 1 THEN
WITH RaTEXTFILE DO
BEGIN
SEEK (LONGDESCPTR);
READ (C, 1);
WHILE (NOT EOF) AND (C <> #0) AND (LINE <= 4) DO
BEGIN
IF LENGTH (Desclines [LINE]) > 78 THEN
INC (LINE);
IF C = #13 THEN
BEGIN
READ (C, 1);
INC (LINE);
END
ELSE
Desclines [LINE] := Desclines [LINE] + C;
READ (C, 1);
END;
END;
END;
PROCEDURE RaList.Premove;
VAR
LINE : BYTE;
C : CHAR;
BEGIN
IF (RarPtr [pkChoice]^.NAME <> '') THEN
BEGIN
FILLCHAR (Desclines , SIZEOF (Desclines), #0);
LINE := 1;
IF RarPtr [pkChoice]^.LONGDESCPTR > - 1 THEN
WITH RaTEXTFILE DO
BEGIN
SEEK (RarPtr [pkChoice]^.LONGDESCPTR);
READ (C, 1);
WHILE (NOT EOF) AND (C <> #0) AND (LINE <= 4) DO
BEGIN
IF LENGTH (Desclines [LINE]) > 78 THEN
INC (LINE);
IF C = #13 THEN
BEGIN
READ (C, 1);
INC (LINE);
END
ELSE
Desclines [LINE] := Desclines [LINE] + C;
READ (C, 1);
END;
END;
END
ELSE
FILLCHAR (Desclines, SIZEOF (Desclines), #0);
FOR LINE := 1 TO 4 DO
RaDescWin^.ffasttext (PAD (Desclines [LINE], 78), LINE, 1);
END;
PROCEDURE RaList.AreaManagerMain;
VAR
FIN : BOOLEAN;
Y, x : BYTE;
Redraw : BOOLEAN;
Inkey : WORD;
sr : SEARCHREC;
BEGIN
{RaDescWin^.Draw;}
Draw;
REPEAT
IF (ChooseFileArea (Inkey) ) AND (CurrentArea <> 0) THEN
BEGIN
wFrame.ChangeHeaderString (0, ' Area : ' + Area^ [CurrentArea]^.title^ + ' ', Redraw);
IF Redraw THEN wFrame.UpDateFrame ELSE wFrame.DrawHeader (0);
IF NOT ISDIRECTORY (JustPathName (FDBPATH) ) THEN
AskError (8, 'Path for fdb does NOT exist', 4)
ELSE
IF RaLoadfiles THEN
BEGIN
FIN := FALSE;
SetChoice (1, 1);
REPEAT
SetKbdStatProc (RaAreaManagerKbdStatProc);
SelectedHeader;
Process;
SetKbdStatProc (NoKbdStatProc);
CASE GETLASTKEY OF
Enter :
BEGIN
IF movemode THEN
BEGIN
movemode := FALSE;
Information ('');
END ELSE
BEGIN
BOOLEAN (RarPtr [pkChoice]^.FREESPACE [20]) := NOT BOOLEAN (RarPtr [pkChoice]^.FREESPACE [20]);
WhereSelect (x, Y);
SetChoice (GetLastChoice + 1, GetLastChoice - Y + 1);
SetFlag (pkSecFlags, pkRedrawOne);
END;
END;
Del,
F2 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode THEN
Deleteline (TRUE);
F3 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode THEN
IF RarPtr [pkChoice]^.NAME <> '' THEN
EditDescField
ELSE
Editdescline;
F4 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode THEN
Moveline;
F5 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode THEN
RenameLine;
F6 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode THEN
TouchFile;
INS,
F7 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND NOT movemode THEN
Insertline (pkChoice, TRUE);
F8 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode THEN
RaSortFiles;
F9 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode THEN
BEGIN
IF (RarPtr [pkChoice]^.NAME <> '') AND (RarPtr [pkChoice]^.FREESPACE [1] = 0) THEN
BEGIN
ViewArchive (addbackslash (Area^ [CurrentArea]^.path^) + RarPtr [pkChoice]^.NAME,
ArcType (RarPtr [pkChoice]^.NAME) );
Information ('');
FINDFIRST (RarPtr [pkChoice]^.NAME, Archive, sr);
FindClose(Sr);
RarPtr [pkChoice]^.FILEDATE := sr.time;
RarPtr [pkChoice]^.NAME := sr.NAME;
RarPtr [pkChoice]^.SIZE := sr.SIZE;
END;
END;
F10 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND NOT movemode THEN
GlobalCommands;
ShF1 : SendFilesToNode;
ShF2 : HatchFiles;
ShF3 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode AND
(RarPtr [pkChoice]^.NAME = '') THEN
Centerline;
ShF4 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 1) AND NOT movemode AND
(RarPtr [pkChoice]^.NAME = '') AND (RarPtr [pkChoice + 1]^.NAME = '') THEN
Joinlines;
ShF9 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode AND
(RarPtr [pkChoice]^.NAME <> '') AND (RarPtr [pkChoice]^.FREESPACE [1] = 0) THEN
ViewGIF;
AltF3 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode THEN
ImportDescription;
Esc : FIN := TRUE;
ShF10 : IF WritableFile (Area^ [CurrentArea]^.FPath^) AND (Ralines > 0) AND NOT movemode THEN
BEGIN
IF RarPtr [pkChoice]^.NAME <> '' THEN
EDITATTRIBUTES
ELSE
Editdescline;
END;
Star,PadStar : Reverse_Select;
Plus,PadPlus : MenuSelect(TRUE);
Minus, PadMinus : MenuSelect(FALSE);
END;
IF NOT GETLASTKEY = Enter THEN TotalHeader;
UNTIL FIN;
RaWritefiles;
END ELSE
BEGIN
AskError (8, 'Insufficient memory to enter this area', 3);
RaDelocatefiles;
END;
END;
UNTIL Inkey = Esc;
END;
END.